home *** CD-ROM | disk | FTP | other *** search
/ Delphi Informant Complete 1995 - 2000 / Delphi Informant Complete 1995 to 2000.iso / Delphi Informant Magazine Complete Works SOURCE CODE 1995.rar / 1995 / SEP / GE9509 / speed.pas < prev    next >
Pascal/Delphi Source File  |  1995-08-21  |  9KB  |  290 lines
  1. unit Speed;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes,
  7.   Graphics, Controls, Forms, Dialogs, StdCtrls,
  8.   Buttons, Menus, ShellAPI, ExtCtrls, DB, DBTables;
  9.  
  10. type
  11.   TSpeedButtonNotifyEvent = procedure(Sender: TSpeedButton) of object;
  12.   TMenuNotifyEvent = procedure(Sender: TMenuItem) of object;
  13.  
  14.   TForm1 = class(TForm)
  15.     MainMenu1: TMainMenu;
  16.     Style1: TMenuItem;
  17.     Normal1: TMenuItem;
  18.     Alwaysontop1: TMenuItem;
  19.     Buttons1: TMenuItem;
  20.     { dialogs }
  21.     OpenDialog1: TOpenDialog;
  22.     Panel1: TPanel;
  23.     Table1: TTable;
  24.     AddButtons: TMenuItem;
  25.     Removebutton1: TMenuItem;
  26.     { events }
  27.     procedure Normal1Click(Sender: TObject);
  28.     procedure Alwaysontop1Click(Sender: TObject);
  29.     procedure AddButtonsClick(Sender: TObject);
  30.     procedure Removebutton1Click(Sender: TObject);
  31.     procedure FormCreate(Sender: TObject);
  32.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  33.   private
  34.     { Private declarations }
  35.     procedure CreateNewSpeedButton(ButtonNum:Integer; NewApp: String;
  36.                                    GlyphFile: TFileName);
  37.     procedure SaveSpeedButton(ButtonNum: Integer;
  38.                               NewApp: String; GlyphFile: TFileName);
  39.     procedure GetButtonsFromTable;
  40.     procedure DeleteItemFromTable(Command: String);
  41.     procedure FreeButtons;
  42.     procedure ExecuteFile(Command,Params,WorkDir: String);
  43.     { private generic event handler }
  44.     procedure GenericSpeedButtonClick(Sender: TSpeedButton);
  45.   public
  46.     { Public declarations }
  47.   end;
  48.  
  49. var
  50.   Form1: TForm1;
  51.   NewSpeedButton: TSpeedButton;
  52.   ButtonNum : Integer;
  53.   RemoveButton : Integer; {test flag}
  54.   ButtonList : TList;
  55.  
  56. implementation
  57.  
  58. {$R *.DFM}
  59.  
  60. { form open and close events }
  61. { When the form opens:
  62. * create a list to hold the speed buttons;
  63. * reset the button count to 0;
  64. * get previous session's buttons from a table. }
  65. procedure TForm1.FormCreate(Sender: TObject);
  66. begin
  67.   {ICG Added the following 2 lines of code for Table1 object}
  68.   Table1.DatabaseName := ExtractFilePath(ExpandFileName('Speed.pas'));
  69.   Table1.Active := True;
  70.  
  71.   ButtonList := TList.Create; {create the speedbutton list }
  72.   ButtonNum := 0;
  73.   GetButtonsFromTable;
  74. end;
  75.  
  76. { When the form closes:
  77. * release the memory allocated to the button list. }
  78. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  79. begin
  80.   ButtonList.Free;   {Free the speedbutton list }
  81. end;
  82.  
  83. procedure TForm1.GetButtonsFromTable;
  84. var
  85.   NewApp: string;
  86.   Glyphfile: TFileName;
  87.   I : Integer;
  88. begin
  89.   try
  90.     { Move to the beginning of the table}
  91.     Table1.Open;
  92.     Table1.First;
  93.     while not Table1.EOF do
  94.       begin
  95.         ButtonNum := ButtonNum + 1;
  96.         NewApp    := Table1.FieldByName('Hint').AsString;
  97.         GlyphFile := Table1.FieldByName('GlyphFile').AsString;
  98.         CreateNewSpeedButton(ButtonNum,NewApp,GlyphFile);
  99.         Table1.Next;
  100.       end;
  101.   finally
  102.     Table1.Close;
  103.   end;
  104. end;
  105.  
  106. { generic execute file routine }
  107. procedure TForm1.ExecuteFile(Command, Params, WorkDir: string);
  108. begin
  109.   { convert Pascal string to Null-termintated strings }
  110.   Command := Command + #0;
  111.   Params := Params + #0;
  112.   WorkDir := WorkDir + #0;
  113.   { run/open application/file }
  114.   if ShellExecute(Application.MainForm.Handle,'Open',@Command[1],
  115.                   @Params[1], @WorkDir[1], SW_SHOWNORMAL) < 32 then
  116.     MessageDlg('Could not execute ' + Command,mtError,[mbOK],0);
  117. end;
  118.  
  119. procedure TForm1.FreeButtons;
  120. var
  121.    I : Integer;
  122. begin
  123.   {Go through the button list until the end is reached;
  124.   * release the memory allocated to each speed button
  125.   * remove the button from the list. }
  126.   for I := 0 to (ButtonList.Count - 1) do
  127.     begin
  128.       NewSpeedButton := ButtonList.Items[0];
  129.       NewSpeedButton.Free;
  130.       ButtonList.Remove(NewSpeedButton);
  131.     end;
  132.   ButtonNum := 0;
  133. end;
  134.  
  135. { Use the existing key to find the item to delete;
  136. or alternatively define a key here. }
  137. procedure TForm1.DeleteItemFromTable(Command: String);
  138. begin
  139.   Table1.Open;           { open table }
  140.   Table1.FindKey([Command]); { use existing key }
  141.   Table1.Edit;           { Hint field is the key }
  142.   Table1.Delete;         { Delete this item, button.hint, from table }
  143.   Table1.Close;          { Close table }
  144. end;
  145.  
  146. { Generic speedbutton click }
  147. { Can either set up a new speedbutton toolbar or execute a file }
  148. procedure TForm1.GenericSpeedButtonClick(Sender:TSpeedButton);
  149. var
  150.   Command, Params, WorkDir: String;
  151. begin
  152.   Command := Sender.Hint;  { Get the file name and path from hint }
  153.   if RemoveButton = 1 then { Edit table - remove button }
  154.     begin
  155.       DeleteItemFromTable(Command); { Remove button }
  156.       FreeButtons;      { Remove existing buttons, release memory }
  157.       GetButtonsFromTable;   { Reload the new table of buttons}
  158.       RemoveButton := 0;     { Reset button count }
  159.       ShowMessage('Returning to Run Mode');
  160.     end
  161.   else                        { execute file }
  162.     begin
  163.       Params := '';
  164.       WorkDir := '';
  165.       ExecuteFile(Command, Params, WorkDir);
  166.     end;
  167. end;
  168.  
  169. procedure TForm1.CreateNewSpeedButton(ButtonNum: Integer;
  170.                         NewApp: String; GlyphFile: TFileName);
  171. var
  172.   EventName : TSpeedButtonNotifyEvent;
  173. begin
  174.   try
  175.     NewSpeedButton := TSpeedButton.Create(Self);
  176.     NewSpeedButton.Glyph.LoadFromFile(GlyphFile);
  177.     NewSpeedButton.Parent    := Panel1;
  178.     NewSpeedButton.Left      := (ButtonNum - 1) * 26;
  179.     NewSpeedButton.Top       := 0;
  180.     NewSpeedButton.Hint      := NewApp;
  181.     NewSpeedButton.ShowHint  := True;
  182.     NewSpeedButton.NumGlyphs := 2;  { Assuming 2-image bitmap. }
  183.     ButtonList.Add(NewSpeedButton); { Add instance to list }
  184.     { Assign new event, created at runtime, to
  185.       the speed Button OnClick event, GenericSpeedButtonClick }
  186.     EventName := GenericSpeedButtonClick;
  187.     NewSpeedButton.OnClick := TNotifyEvent(EventName);
  188.   except
  189.     on E: EInOutError do
  190.       begin
  191.         MessageDlg('Unable to create speed button. ' +
  192.         E.Message, mtInformation, [mbOK],0);
  193.         NewSpeedButton.Free;   { Free button resources }
  194.         ButtonNum := ButtonNum - 1;
  195.       end;
  196.   end;
  197. end;
  198.  
  199. { Use the Open Dialog to get a file name and
  200.   a corresponding bitmap for the new speed button
  201.   to be associated with the file }
  202. procedure TForm1.AddButtonsClick(Sender: TObject);
  203. var
  204.   NewApp: string;
  205. begin
  206.   OpenDialog1.Title := 'Select a file to associate with a button.';
  207.   OpenDialog1.Filter := 'All files|*.*';
  208.   OpenDialog1.FileName := '';
  209.   if OpenDialog1.Execute then
  210.     begin
  211.       NewApp:= OpenDialog1.FileName;
  212.       if FileExists(NewApp) then
  213.         begin
  214.           OpenDialog1.InitialDir := '';
  215.           OpenDialog1.Title := 'Select a glyph for the speed button.';
  216.           OpenDialog1.Filter := 'Bitmap files|*.bmp';
  217.           OpenDialog1.FileName := '';
  218.           if OpenDialog1.Execute then
  219.             begin
  220.               ButtonNum := ButtonNum + 1;
  221.               CreateNewSpeedButton(ButtonNum,NewApp,OpenDialog1.FileName);
  222.               SaveSpeedButton(ButtonNum,NewApp,OpenDialog1.FileName);
  223.               RemoveButton := 0; { Set Remove Button flag to false }
  224.               ShowMessage('In Run Mode');
  225.             end;
  226.         end
  227.       else
  228.         ShowMessage('File does not exist.');
  229.     end;
  230. end;
  231.  
  232. { Remove button click event simply sets a remove flag,
  233.   which the generic click event checks before deciding
  234.   how to carry out the click event. }
  235. procedure TForm1.Removebutton1Click(Sender: TObject);
  236. begin
  237. if MessageDlg('Remove next selected button?',
  238.               mtInformation,[mbYes, mbNo],0) = mrYes then
  239.   RemoveButton := 1
  240. else
  241.   begin
  242.     RemoveButton := 0;
  243.     ShowMessage('Returning to Run Mode');
  244.   end;
  245. end;
  246.  
  247. { Add each new speed button to the end of the
  248.   speed button table }
  249. procedure TForm1.SaveSpeedButton(ButtonNum: Integer;
  250.                         NewApp: String; GlyphFile: TFileName);
  251. var
  252.   S : String;
  253. begin
  254.   { add to speedo table }
  255.   with Table1 do
  256.     try
  257.       { Move to the end of the table}
  258.       O